home *** CD-ROM | disk | FTP | other *** search
/ Aminet 22 / Aminet 22 (1997)(GTI - Schatztruhe)[!][Dec 1997].iso / Aminet / game / role / DSA_Utils.lha / DSA-Utils / DSA_Dorf.p < prev    next >
Text File  |  1997-09-21  |  33KB  |  830 lines

  1. { ex: ts=2 ai
  2.  }
  3. program DSA_Dorf;    { Version 2.2 · 1.`96 }
  4.  
  5. {$R+}
  6.  
  7.     { Generiert ein Dorf (nach DSA-Regeln)
  8.         Quelle f\"ur die Texte: "Das Handbuch f\"ur den Reisenden"
  9.                 (© copyright Schmidt Spiel & Freizeit GmbH)
  10.         © copyright 1995/96 by Henning Peters
  11.             E-Mail: faroul@beyond.hb.north.de
  12.             Fido-Mail: 2:2426/3020.28
  13.         Public-Domain - darf zwecks Systemanpassung modifiziert werden;
  14.         dann bitte Source an mich senden.
  15.     }
  16.  
  17. {$I-}
  18. {$I "include:utils/StringLib.i"}
  19. {$I "include:utils/Random.i"}
  20.  
  21. const
  22.     Version="2.2";
  23.     c_Groesse=30;
  24.     c_Tempel:array[1..12]of string=
  25.         ("Peraine","Travia","Efferd","Rahja","Phex","Rondra","Ingerimm","Praios",
  26.             "Hesinde","Tsa","Boron","Firun");
  27.     c_HandwI:array[1..7] of string=
  28.         ("Grobschmied","Hufschmied","Sattler","Schuster","Grobschneider","Tischler",
  29.             "Zimmermann");
  30.     c_HandwII:array[1..23]of string=
  31.         ("Fleischer","Bootsbauer","Schnapsbrenner","Brotb\"acker","Netzkn\"upfer",
  32.             "Kunstschmied","Waffenschmied","Bogenbauer","Armbruster","Bronzegie\"ser",
  33.             "K\"urschner","Gerber","F\"arber","K\"ufer","Kerzenzieher","T\"opfer","Zinngie\"ser",
  34.             "Tuchmacher","Seiler","Wagner","Drechsler","M\"uller","N\"aherin");
  35.     c_HandwIII:array[1..12]of string=
  36.         ("Dachdecker","Konditor","Baumeister","K\"unstler","Gelehrter","Graveur",
  37.             "Hofschneider","Glasbl\"aser","Instrumentenbauer","Kammerj\"ager",
  38.             "Prothesenmacher","Alchimist");
  39.     c_Gross:array[1..12]of string=
  40.         ("Brauerei","Spinnerei","Weinkellerei","Weberei","Drahtzieherei",
  41.             "Stellmacherei","Werft","Druckerei/Buchbinderei","Papierm\"uhle","Gie\"serei",
  42.             "Mine","K\"aserei");
  43.     c_HaendlI:array[1..3]of string=
  44.         ("Ausr\"ustung","Lebensmittel","Kr\"amerwaren");
  45.     c_HaendlII:array[1..8]of string=
  46.         ("spezielle Lebensmittel","Gew\"urze","Schmuck","Waffen","Vieh","Tuche",
  47.             "Kleidung","Kr\"auter");
  48.     c_HaendlIII:array[1..10]of string=
  49.         ("Feinkost","hei\"se Waren (Hehler)","Edelsteine","Andenken","Wein","Apotheke",
  50.             "Teppiche","G\"uldenlandwaren","Zauberwerk","Spezialgesch\"aft");
  51.     c_DienstI:array[1..4]of string=
  52.         ("Badehaus","Bordell","Barbier","Schreiber");
  53.     c_DienstII:array[1..14]of string=
  54.         ("Kurier-/Botendienst","Reederei","Pfandhaus","Droschkenverleih","Wahrsager",
  55.             "Seelenheiler","S\"oldner und Besch\"utzer","Schule","Geldwechsler",
  56.             "Fremdenf\"uhrer","Traumdeuter","Geisteraustreiber","Rechtsgelehrter","Zauberer");
  57.     c_Heilk:array[1..4]of string=
  58.         ("Medikus","Heiler","Hebamme","Quacksalber");
  59.     c_Durch:array[1..10]of string=
  60.         ("Korbmacher","Scherenschleifer","Kesselflicker","Gaukler","Musikanten",
  61.             "Quacksalber","Zahnbrecher","Kuriosit\"atenkr\"amer","Geschichtenerz\"ahler",
  62.             "Wahrsager");
  63.     c_QuaPreis:array[1..20]of short=
  64.         (4,4,2,2,2,2,0,0,0,0,0,0,0,0,-1,-1,-1,-1,-3,-3);
  65.     c_Siehe="siehe St\"adtebeschreibung in \"Das Land des Schwarzen Auges\".";
  66.  
  67. type
  68.     t_Feld=(f_Haus1,f_Haus2,f_Haus3,f_Haus4,f_Haus5,f_Tempel1,f_Tempel2,f_Hotel1,
  69.                     f_Hotel2,f_Hotel3,f_Kneipe1,f_Kneipe2,f_HandwI,f_HandwII,f_HandwIII,
  70.                     f_Gross,f_HaendlI,f_HaendlII,f_HaendlIII,f_DienstI,f_DienstII,f_Heilk,
  71.                     f_Durch,f_Markt,f_Teich,f_Baum1,f_Baum2,f_Baum3,f_Leer);
  72.     t_Dorf=record
  73.         Feld:t_Feld;
  74.         num:byte
  75.     end;
  76.     t_Richtung=(runter,rechts);
  77.     t_Weg=record
  78.         x,y,l:short;
  79.         r:t_Richtung;
  80.         next:^t_Weg;
  81.     end;
  82.   p_Weg=^t_Weg;
  83.  
  84. var
  85.     Einw,xy,Dorf_Num,Tempel,Hotels,Kneipen,HandwI,HandwII,HandwIII,Gross,HaendlI,
  86.     HaendlII,HaendlIII,DienstI,DienstII,Heilk,Durch,Markt,Qual,PreisHa,PreisHw:short;
  87.     Ausfile:text;
  88.     Aus_Leer,ok:boolean;
  89.     str,Name:string;
  90.     Dorf:array[1..c_Groesse,1..c_Groesse]of t_Dorf;
  91.     Weg:p_Weg;
  92.     Bau:array[f_Haus1..f_Leer]of string;
  93.     Vorh:array[f_Haus1..f_Durch]of integer;
  94.  
  95.  
  96. function PreisText(p:byte):string;
  97. begin
  98.     case p of
  99.         0..2:     PreisText:="sehr billig";
  100.         3,4:        PreisText:="billig";
  101.         5..12:    PreisText:="durchschnittlich";
  102.         13..18:    PreisText:="teuer";
  103.         19:            PreisText:="sehr teuer";
  104.         20:            PreisText:="Wucher"
  105.     end
  106. end;
  107.  
  108. function QualText(q:byte):string;
  109. begin
  110.     case q of
  111.         1..2:        QualText:="sehr gut";
  112.         3..6:        QualText:="gut";
  113.         7..14:    QualText:="durchschnittlich";
  114.         15,16:    QualText:="m\"a\"sig";
  115.         17,18:    QualText:="schlecht";
  116.         19,20:    QualText:="miserabel"
  117.     end
  118. end;
  119.  
  120. function int_str(i:integer):string;    { i=0..999 }
  121. var str:string;
  122. begin str:=AllocString(5);
  123.     if i<10 then begin
  124.         str[0]:=chr(i+48); str[1]:='\0'
  125.     end else if i<100 then begin
  126.         str[0]:=chr(i div 10+48); str[1]:=chr(i mod 10+48); str[2]:='\0'
  127.         end else begin
  128.             str[0]:=chr(i div 100+48); str[1]:=chr((i mod 100)div 10+48);
  129.             str[2]:=chr(i mod 10+48); str[3]:='\0'
  130.         end;
  131.     int_str:=str
  132. end;
  133.  
  134. function str_int(str:string):short;
  135. var i,j:integer;
  136.         s,l,n:short;
  137. begin
  138.     i:=0; l:=pred(strlen(str)); if str[0]='-' then s:=1 else s:=0;
  139.     for j:=s to l do begin
  140.         n:=ord(str[j])-48;
  141.         if (n<0) or (n>9) then str_int:=0;
  142.         i:=i*10+n
  143.     end;
  144.     if str[0]='-' then str_int:=-i else str_int:=i
  145. end;
  146.  
  147. function Wurf(w:short):short;
  148. begin
  149.     if w<2 then Wurf:=1;    { Bei mir: Func:=Wert -> Exit Func }
  150.     Wurf:=succ(RangeRandom(pred(w)))
  151. end;    { RangeRandom(n) liefert 0..n; f\"ur 1..6 also (0..(6-1))+1 }
  152.  
  153. function Zero(a:short):short;
  154. begin
  155.     if a<0 then Zero:=0;
  156.     Zero:=a;
  157. end;
  158.  
  159. function Range(a,b:short):short;
  160. begin
  161.     if a<0 then Range:=0 else if a>b then Range:=b;
  162.     Range:=a;
  163. end;
  164.  
  165. procedure Eingabe;
  166. var s:string;
  167.         c:char;
  168. begin
  169.     s:=AllocString(20);
  170.     repeat
  171.         write("\n\nEingabe der Dorfdaten\n  (keine Kontrolle der Zahlenwerte, Falscheingaben werden als 0 gezählt!)\n\n  Anzahl der Einwohner:              ");
  172.         readln(s); Einw:=str_int(s);
  173.         write("  Anzahl der Tempel:                 "); readln(s); Tempel:=str_int(s);
  174.         write("             Hotels:                 "); readln(s); Hotels:=str_int(s);
  175.         write("             Kneipen:                "); readln(s); Kneipen:=str_int(s);
  176.         write("             Handwerker I:           "); readln(s); HandwI:=str_int(s);
  177.         write("             Handwerker II:          "); readln(s); HandwII:=str_int(s);
  178.         write("             Handwerker III:         "); readln(s); HandwIII:=str_int(s);
  179.         write("             Großbetriebe:           "); readln(s); Gross:=str_int(s);
  180.         write("             Händler I:              "); readln(s); HaendlI:=str_int(s);
  181.         write("             Händler II:             "); readln(s); HaendlII:=str_int(s);
  182.         write("             Händler III:            "); readln(s); HaendlIII:=str_int(s);
  183.         write("             Dienstleistungen I:     "); readln(s); DienstI:=str_int(s);
  184.         write("             Dienstleistungen II:    "); readln(s); DienstII:=str_int(s);
  185.         write("             Heilkundigen:           "); readln(s); Heilk:=str_int(s);
  186.         write("             Durchfahrenden:         "); readln(s); Durch:=str_int(s);
  187.         write("             Markttage (-1=ständig): "); readln(s); Markt:=str_int(s);
  188.         write("  Qualitätsniveau (-2 bis 3):        "); readln(s); Qual:=str_int(s);
  189.         write("  Preisniveau Händler (0 bis 3):     "); readln(s); PreisHa:=str_int(s);
  190.         write("  Preisniveau Handwerker (-5 bis 3): "); readln(s); PreisHw:=str_int(s);
  191.         write("\nAlle Eingaben richtig (j/n)? "); readln(s);
  192.     until tolower(s[0])='j';
  193.     write("\nErstelle Dorf")
  194. end;
  195.  
  196. procedure Generate_Bild;
  197. var i,j:integer;
  198.         nr,zz,Baeume:byte;
  199.         q,x,y,ay,Teiche,Haeuser:short;
  200.         wt,wp:p_Weg;
  201.  
  202.     procedure Generate_Gebaeude;
  203.     begin
  204.         repeat inc(zz); if zz>12 then begin write('.'); zz:=0 end;
  205.             x:=Wurf(xy); y:=Wurf(xy); ay:=y;
  206.             while (Dorf[x,y].Feld<>f_Leer) and (ay<xy) do begin inc(x);
  207.                 if x>xy then begin
  208.                     inc(y); x:=1; if y>xy then y:=1 else if y=ay then ay:=99
  209.                 end
  210.             end;
  211.             if ay>xy then begin
  212.                 write("Konnte nicht alle Gebäude etc. verteilen!"); return
  213.             end;
  214.             if Markt>0 then begin
  215.                 while (y=xy) or (x=xy) or ((Dorf[x,y].Feld<>f_Leer) and
  216.                              (Dorf[x,succ(y)].Feld<>f_Leer) and (Dorf[succ(x),y].Feld<>f_Leer) and
  217.                              (Dorf[succ(x),succ(y)].Feld<>f_Leer))
  218.                 do begin inc(x);
  219.                     if x>=xy then begin
  220.                         inc(y); x:=1; if y>=xy then y:=1
  221.                     end
  222.                 end;
  223.                 Dorf[x,y].Feld:=f_Markt; Dorf[succ(x),y].Feld:=f_Markt;
  224.                 Dorf[x,succ(y)].Feld:=f_Markt; Dorf[succ(x),succ(y)].Feld:=f_Markt; 
  225.                 dec(Markt)
  226.             end else if Tempel>0 then begin
  227.                 if Wurf(2)=1 then Dorf[x,y].Feld:=f_Tempel1 else Dorf[x,y].Feld:=f_Tempel2;
  228.                 dec(Tempel); Dorf[x,y].num:=nr; inc(nr)
  229.             end else if Haeuser>0 then begin
  230.                 case Wurf(5) of
  231.                     1:Dorf[x,y].Feld:=f_Haus1;
  232.                     2:Dorf[x,y].Feld:=f_Haus2;
  233.                     3:Dorf[x,y].Feld:=f_Haus3;
  234.                     4:Dorf[x,y].Feld:=f_Haus4;
  235.                     5:Dorf[x,y].Feld:=f_Haus5
  236.                 end;
  237.                 dec(Haeuser)
  238.             end else if Hotels>0 then begin
  239.                 case Wurf(3) of
  240.                     1:Dorf[x,y].Feld:=f_Hotel1;
  241.                     2:Dorf[x,y].Feld:=f_Hotel2;
  242.                     3:Dorf[x,y].Feld:=f_Hotel3
  243.                 end;
  244.                 dec(Hotels); Dorf[x,y].num:=nr; inc(nr)
  245.             end else if Kneipen>0 then begin
  246.                 if Wurf(2)=1 then Dorf[x,y].Feld:=f_Kneipe1 else Dorf[x,y].Feld:=f_Kneipe2;
  247.                 dec(Kneipen); Dorf[x,y].num:=nr; inc(nr)
  248.             end else if HandwI>0 then begin
  249.                 Dorf[x,y].Feld:=f_HandwI; dec(HandwI); Dorf[x,y].num:=nr; inc(nr)
  250.             end else if HandwII>0 then begin
  251.                 Dorf[x,y].Feld:=f_HandwII; dec(HandwII); Dorf[x,y].num:=nr; inc(nr)
  252.             end else if HandwIII>0 then begin
  253.                 Dorf[x,y].Feld:=f_HandwIII; dec(HandwIII); Dorf[x,y].num:=nr; inc(nr)
  254.             end else if Gross>0 then begin
  255.                 Dorf[x,y].Feld:=f_Gross; dec(Gross); Dorf[x,y].num:=nr; inc(nr)
  256.             end else if HaendlI>0 then begin
  257.                 Dorf[x,y].Feld:=f_HaendlI; dec(HaendlI); Dorf[x,y].num:=nr; inc(nr)
  258.             end else if HaendlII>0 then begin
  259.                 Dorf[x,y].Feld:=f_HaendlII; dec(HaendlII); Dorf[x,y].num:=nr; inc(nr)
  260.             end else if HaendlIII>0 then begin
  261.                 Dorf[x,y].Feld:=f_HaendlIII; dec(HaendlIII); Dorf[x,y].num:=nr; inc(nr)
  262.             end else if DienstI>0 then begin
  263.                 Dorf[x,y].Feld:=f_DienstI; dec(DienstI); Dorf[x,y].num:=nr; inc(nr)
  264.             end else if DienstII>0 then begin
  265.                 Dorf[x,y].Feld:=f_DienstII; dec(DienstII); Dorf[x,y].num:=nr; inc(nr)
  266.             end else if Heilk>0 then begin
  267.                 Dorf[x,y].Feld:=f_Heilk; dec(Heilk); Dorf[x,y].num:=nr; inc(nr)
  268.             end else if Teiche>0 then begin
  269.                 Dorf[x,y].Feld:=f_Teich; dec(Teiche)
  270.             end else if Baeume>0 then begin
  271.                 case Wurf(3) of
  272.                     1:Dorf[x,y].Feld:=f_Baum1;
  273.                     2:Dorf[x,y].Feld:=f_Baum2;
  274.                     3:Dorf[x,y].Feld:=f_Baum3
  275.                 end;
  276.                 dec(Baeume)
  277.             end
  278.         until Baeume=0;
  279.     end;
  280.  
  281.     procedure Gen_Weg(w:p_Weg; p:byte);
  282.     var i:integer;
  283.     begin
  284.         inc(p,RangeRandom((zz-p)shr 1));
  285.         if w^.r=runter then w^.y:=p else w^.x:=p;
  286.         while Dorf[w^.x,w^.y].Feld=f_Markt do begin
  287.             inc(p); if w^.r=runter then w^.y:=p else w^.x:=p
  288.         end;
  289.         w^.l:=(zz-p)shr 2+Wurf(trunc((zz-p)*0.75)); i:=1;
  290.         repeat
  291.             if w^.r=runter then begin
  292.                 if Dorf[w^.x,w^.y+i].Feld=f_Markt then begin
  293.                     w^.l:=pred(i); i:=xy
  294.                 end
  295.             end else
  296.                 if Dorf[w^.x+i,w^.y].Feld=f_Markt then begin
  297.                     w^.l:=pred(i); i:=xy
  298.                 end;
  299.             inc(i)
  300.         until i>zz;    { keine Wege quer durch Marktpl\"atze }
  301.         if (w^.l=0) and (p+w^.l<zz-5) then Gen_Weg(w,succ(p));
  302.     end;
  303.  
  304.  
  305.     procedure Generate_Weg;
  306.     begin
  307.         new(wp); wp^.x:=0; wp^.y:=xy div 4+Wurf(xy div 2); zz:=pred(xy);
  308.         wp^.l:=xy; wp^.r:=rechts; Weg:=wp; nr:=1;
  309.         repeat
  310.             q:=0;
  311.             while q<0.75*xy do begin
  312.                 if Wurf(q)>xy/3 then inc(nr);
  313.               new(wt); wt^.r:=runter; wt^.x:=nr; Gen_Weg(wt,q);
  314.                 if wt^.l>0 then begin wp^.next:=wt; wp:=wt; q:=wp^.y+wp^.l end
  315.                 else q:=xy
  316.             end; q:=0;
  317.             while q<0.75*xy do begin
  318.                 if Wurf(q)>xy/3 then inc(nr);
  319.               new(wt); wt^.r:=rechts; wt^.y:=nr; Gen_Weg(wt,q);
  320.                 if wt^.l>0 then begin wp^.next:=wt; wp:=wt; q:=wp^.x+wp^.l end
  321.                 else q:=xy
  322.             end;
  323.             inc(nr); if Wurf(10)>3 then inc(nr); if Wurf(10)>3 then inc(nr);
  324.         until nr>zz;
  325.         wt^.next:=nil
  326.     end;
  327.  
  328. begin {Generate_Bild}
  329.     Baeume:=Dorf_Num shl 1; if Wurf(10)>6 then Teiche:=Wurf(Dorf_Num) else Teiche:=0;
  330.     Haeuser:=xy*xy-Tempel-Hotels-Kneipen-HandwI-HandwII-HandwIII-Gross-HaendlI-
  331.         HaendlII-HaendlIII-DienstI-DienstII-Heilk-Markt shl 2-Baeume-Teiche-
  332.         RangeRandom(xy);
  333.     zz:=0; nr:=1; Markt:=Markt div 2;
  334.     Generate_Gebaeude; Generate_Weg
  335. end;
  336.  
  337. procedure Generate_Dorf;
  338. begin
  339.     write("\nGeneriere Dorf (Größe ",Dorf_Num,')');
  340.     case Dorf_Num of
  341.         1:begin    { -100 EW } 
  342.                 Tempel:=RangeRandom(1); Hotels:=Zero(Wurf(3)-2); Kneipen:=Wurf(2);
  343.                 HandwI:=Rangerandom(1); HandwII:=0; HandwIII:=0; Gross:=0;
  344.                 HaendlI:=Zero(Wurf(3)-2); HaendlII:=0; HaendlIII:=0;
  345.                 DienstI:=0; DienstII:=0; Heilk:=Zero(Wurf(3)-2);
  346.                 Durch:=1; Markt:=0; Qual:=1; PreisHa:=3; PreisHw:=-5; Einw:=100;
  347.             end;
  348.         2:begin    { -250 EW }
  349.                 Tempel:=Wurf(2); Hotels:=Zero(Wurf(3)-1); Kneipen:=succ(Wurf(2));
  350.                 HandwI:=Wurf(3); HandwII:=Zero(Wurf(6)-5); HandwIII:=0; Gross:=0;
  351.                 HaendlI:=Zero(pred(Wurf(2))); HaendlII:=0; HaendlIII:=0;
  352.                 DienstI:=Zero(Wurf(6)-5); DienstII:=0; Heilk:=Zero(pred(Wurf(2)));
  353.                 Durch:=1; Markt:=0; Qual:=2; PreisHa:=2; PreisHw:=-3; Einw:=250;
  354.             end;
  355.         3:begin    { -500 EW }
  356.                 Tempel:=Wurf(3); Hotels:=succ(Wurf(2)); Kneipen:=succ(Wurf(3));
  357.                 HandwI:=Wurf(3); HandwII:=Zero(Wurf(3)-2); HandwIII:=0; Gross:=0;
  358.                 HaendlI:=Wurf(2); HaendlI:=Zero(Wurf(3)-2); HaendlIII:=0;
  359.                 DienstI:=Zero(Wurf(3)-2); DienstII:=0; Heilk:=Wurf(2);
  360.                 Durch:=1; Markt:=2; Qual:=2; PreisHa:=2; PreisHw:=-2; Einw:=500;
  361.             end;
  362.         4:begin    { -1000 EW }
  363.                 Tempel:=succ(Wurf(2)); Hotels:=succ(Wurf(3)); Kneipen:=Wurf(3)+2;
  364.                 HandwI:=succ(Wurf(2)); HandwII:=Zero(pred(Wurf(2)));
  365.                 HandwIII:=Zero(Wurf(6)-5); Gross:=0;
  366.                 HaendlI:=succ(Wurf(2)); HaendlII:=Zero(pred(Wurf(2)));
  367.                 HaendlIII:=Zero(Wurf(6)-5);
  368.                 DienstI:=Zero(pred(Wurf(2))); DienstII:=0; Heilk:=Wurf(3);
  369.                 Durch:=2; Markt:=4; Qual:=3; PreisHa:=2; PreisHw:=-1; Einw:=1000;
  370.             end;
  371.         5:begin    { -2500 EW }
  372.                 Tempel:=-1; Hotels:=Wurf(3)+3; Kneipen:=Wurf(3)+3;
  373.                 { -1 Tempel -> siehe St\"adtebeschreibung in "Das Land des Schwarzen Auges" }
  374.                 HandwI:=succ(Wurf(3)); HandwII:=Wurf(2); HandwIII:=Zero(pred(Wurf(2)));
  375.                 Gross:=Zero(Wurf(3)-2);
  376.                 HaendlI:=succ(Wurf(3)); HaendlII:=Wurf(2); HaendlIII:=Zero(pred(Wurf(2)));
  377.                 DienstI:=Wurf(2); DienstII:=Zero(Wurf(3)-2); Heilk:=succ(Wurf(3));
  378.                 Durch:=2; Markt:=8; Qual:=1; PreisHa:=0; PreisHw:=0; Einw:=2500;
  379.             end;
  380.         6:begin    { -5000 EW }
  381.                 Tempel:=-1; Hotels:=Wurf(3)+5; Kneipen:=Wurf(3)+5;
  382.                 HandwI:=Wurf(3)+2; HandwII:=Wurf(3); HandwIII:=Zero(pred(Wurf(2)));
  383.                 Gross:=RangeRandom(2);
  384.                 HaendlI:=Wurf(3)+2; HaendlII:=succ(Wurf(3)); HaendlIII:=Wurf(2);
  385.                 DienstI:=succ(Wurf(2)); DienstII:=Wurf(2); Heilk:=Wurf(3)+3;
  386.                 Durch:=3; Markt:=12; Qual:=-1; PreisHa:=1; PreisHw:=1; Einw:=5000;
  387.             end;
  388.         7:begin    { -10000 EW }
  389.                 Tempel:=-1; Hotels:=Wurf(6)+7; Kneipen:=Wurf(6)+7;
  390.                 HandwI:=Wurf(3)+4; HandwII:=Wurf(3)+2; HandwIII:=RangeRandom(2);
  391.                 Gross:=Wurf(3);
  392.                 HaendlI:=Wurf(3)+4; HaendlII:=Wurf(3)+2; HaendlIII:=Wurf(3);
  393.                 DienstI:=succ(Wurf(3)); DienstII:=Wurf(3); Heilk:=Wurf(6)+4;
  394.                 Durch:=3; Markt:=-1;    { Markttag immer au\"ser an Feiertagen }
  395.                 Qual:=0; PreisHa:=2; PreisHw:=3; Einw:=10000
  396.             end
  397.     end;
  398.     Einw:=Einw-(Einw shr 2)+Wurf(Einw shr 1);    { +/- 25% }
  399. end;
  400.  
  401. procedure Ausgabe_Bild;
  402. var i,j:integer;
  403.         x,y,l:short;
  404. begin
  405.   for i:=1 to xy do begin write('·');
  406.         for j:=1 to xy do begin
  407.             write(Ausfile," \\put(",pred(i)*32,',',pred(j)*32,"){\\usebox{\\",
  408.                             Bau[Dorf[i,j].Feld],"}}\n");
  409.             if Dorf[i,j].Feld=f_Markt then begin
  410.                 Dorf[succ(i),j].Feld:=f_Leer; Dorf[i,succ(j)].Feld:=f_Leer;
  411.                 Dorf[succ(i),succ(j)].Feld:=f_Leer
  412.             end;    { Markt nimmt 2×2 Felder ein; darum nicht 4* ausgeben }
  413.             if Dorf[i,j].num>0 then
  414.                 write(Ausfile,"  \\put(",pred(i)*32+15,',',pred(j)*32+15,
  415.                             "){\\makebox(0,0){",Dorf[i,j].num,"}}\n");
  416.         end
  417.     end; write(Ausfile," \\thicklines\n"); xy:=xy*32;
  418.     while Weg<>nil do begin
  419.       l:=Weg^.l*32+Wurf(5); x:=Weg^.x*32; y:=Weg^.y*32;
  420.         case Weg^.r of
  421.             rechts:begin
  422.                             write(Ausfile," \\put(",x,',',y,"){\\line(1,0){",l,"}}\n");
  423.                             if l>xy shr 1 then
  424.                                 write(Ausfile," \\put(",x,',',succ(y),"){\\line(1,0){",l,"}}\n");
  425.                         end;
  426.             runter:begin
  427.                             write(Ausfile," \\put(",x,',',y,"){\\line(0,1){",l,"}}\n");
  428.                             if l>xy shr 1 then
  429.                                 write(Ausfile," \\put(",succ(x),',',y,"){\\line(0,1){",l,"}}\n");
  430.                         end
  431.         end;
  432.         Weg:=Weg^.next
  433.     end
  434. end;
  435.  
  436. procedure Ausgabe_Text;
  437. var i:integer;
  438.         j,q,p:short;
  439.         line,num,g,e,d:byte;
  440.         bade,spez:boolean;
  441.  
  442.     function CheckOut(n:byte):boolean;
  443.     begin
  444.         CheckOut:=Aus_Leer or (n>0)
  445.     end;
  446.  
  447.     procedure Ausgabe_TeX_Header(head:string);
  448.     begin
  449.         if num>1 then write(Ausfile,"  \\hline\n \\end{tabular}\n\\vfill\n{\\small\\sf DSA-Dorfgenerator V",Version," -- \\copyright\\ copyright 1995/96 by Henning Peters \\hfill E-Mail: faroul@beyond.hb.north.de -- Fido: 2:2426/3020.28}\n\\newpage\n");
  450.         write(Ausfile,"{\\LARGE\\bf ",Name,"}\\\\[5pt]\n{\\bf (",Einw," Einwohner)}\\\\[15pt]\n \\begin{tabular}{|rcccc|}\n  \\hline\n  \\bf Nr. & \\bf Beschreibung & \\bf Besonderes & \\bf Qualit\"at & \\bf Preisniveau \\\\\n");
  451.         if strlen(head)>1 then write(Ausfile,"  \\hline\\hline\n  \\multicolumn{5}{|c|}{\\large\\bf\\rule{0pt}{2ex} ",head,"}\\\\[3pt]\n");
  452.         line:=1
  453.     end;
  454.  
  455.     function Check_Vorh(t:t_Feld; g:byte):byte;
  456.     var i,z:byte;
  457.             j:integer;
  458.     begin
  459.         i:=Wurf(g); z:=i;
  460.         repeat
  461.             j:=sqr(i); if (Vorh[t] and j)<>0 then inc(i);
  462.             if i>g then i:=1;
  463.             if i=z then Vorh[t]:=0;
  464.         until (Vorh[t] and j)=0;
  465.         Vorh[t]:=Vorh[t] or j;
  466.         Check_Vorh:=i
  467.     end;
  468.  
  469.     procedure Aus_Hot_Kneip_Handw;
  470.     begin
  471.         if CheckOut(Hotels) then begin
  472.             write(Ausfile,"  \\\hline\\hline\n  \\multicolumn{5}{|c|}{\\large\\bf\\rule{0pt}{2ex} Hotels und Gasth\"auser}\\\\\n");
  473.              if Hotels>0 then begin
  474.                 write(Ausfile,"    \\multicolumn{5}{|c|}{\\small(GR=Gruppenschlafraum, EZ=Einzelzimmer,\n        DZ=Doppelzimmer)}\\\\[3pt]\n");
  475.                 for i:=1 to Hotels do begin
  476.                     q:=Range(Wurf(20)+Qual,20);
  477.                     p:=Range(Wurf(20)+PreisHa+c_QuaPreis[q],20);
  478.                     g:=Wurf(Dorf_Num); e:=RangeRandom(Dorf_Num shl 1);
  479.                     d:=RangeRandom(Dorf_Num shl 1);
  480.                     bade:=(Dorf_Num>2) and (RangeRandom(Dorf_Num shl 2)>Dorf_Num*3);
  481.                     spez:=(Dorf_Num>3) and (RangeRandom(Dorf_Num shl 2)>Dorf_Num*3);
  482.                     write(Ausfile,num:4," & ",g," GR"); inc(num); inc(line);
  483.                     if e>0 then write(Ausfile,", ",e," EZ");
  484.                     if d>0 then write(Ausfile,", ",d," DZ");
  485.                     write(Ausfile," & ");
  486.                     if bade then begin
  487.                         if spez then write(Ausfile,"Badem\"ogl.")
  488.                         else write(Ausfile,"Badem\"oglichkeit")
  489.                     end;
  490.                     if spez then begin
  491.                         if bade then write(Ausfile,", spez. Zimmerservice")
  492.                         else write(Ausfile,"spezieller Zimmerservice")
  493.                     end;
  494.                     write(Ausfile," & ");
  495.                     case q of
  496.                         1,2:     write(Ausfile,"nobel und poliert");
  497.                         3..6:  write(Ausfile,"gut und sauber");
  498.                         7..14: write(Ausfile,"solide und sauber");
  499.                         15..18:write(Ausfile,"einfach, fraglich");
  500.                         19,20: write(Ausfile,"schlicht, schmuddelig")
  501.                     end;
  502.                     write(Ausfile," & ",PreisText(p),"\\\\\n")
  503.                 end
  504.             end else write(Ausfile,"    \\multicolumn{5}{|c|}{keine}\\\\\n")
  505.         end;
  506.         if CheckOut(Kneipen) then begin
  507.             write(Ausfile,"  \\\hline\\hline\n  \\multicolumn{5}{|c|}{\\large\\bf\\rule{0pt}{2ex} Kneipen und Sch\"anken}\\\\[3pt]\n");
  508.             for i:=1 to Kneipen do begin
  509.                 q:=Range(Wurf(20)+Qual,20);
  510.                 p:=Range(Wurf(20)+PreisHw+c_QuaPreis[q],20);
  511.                 write(Ausfile,num:4," & "); inc(num); inc(line);
  512.                 case q of
  513.                     1,2:     write(Ausfile,"Nobelrestaurant");
  514.                     3..6:  write(Ausfile,"gepflegtes Lokal");
  515.                     7..14: write(Ausfile,"saubere Sch\"anke");
  516.                     15..18:write(Ausfile,"einfache Kneipe");
  517.                     19,20: write(Ausfile,"schmierige Kaschemme")
  518.                 end;
  519.                 q:=Range(Wurf(20)+Qual,20); write(Ausfile," & ");
  520.                 spez:=(Dorf_Num>2) and (RangeRandom(Dorf_Num shl 2)>Dorf_Num*3);
  521.                 bade:=(Dorf_Num>2) and (RangeRandom(Dorf_Num shl 2)>Dorf_Num*3) and (not spez);
  522.                 if bade then write(Ausfile,"Musik und Gesang");
  523.                 if spez then write(Ausfile,"Tanz und Musik");
  524.                 write(Ausfile," & ",QualText(q)," & ",PreisText(p),"\\\\\n")
  525.             end
  526.         end;
  527.         if CheckOut(HandwI+HandwII+HandwIII) then begin
  528.             write(Ausfile,"  \\\hline\\hline\n  \\multicolumn{5}{|c|}{\\large\\bf\\rule{0pt}{2ex} Handwerker}\\\\[3pt]\n");
  529.             if HandwI>0 then for i:=1 to HandwI do begin
  530.                 q:=Range(Wurf(20)+Qual,20); j:=Check_Vorh(f_HandwI,7);
  531.                 write(Ausfile,num:4," & ",c_HandwI[j]," & "); inc(num); inc(line);
  532.                 case q of
  533.                     1,2:     write(Ausfile,"Spezialist, Wunschanfertigungen");
  534.                     3..6:  write(Ausfile,"Sonderanfertigungen");
  535.                     7..14: write(Ausfile,"solide Handwerksarbeiten");
  536.                     15..18:write(Ausfile,"einfache Arbeiten");
  537.                     19,20: write(Ausfile,"Pfuscher")
  538.                 end;
  539.                 if q<19 then q:=Range(Wurf(20)+Qual,20);
  540.                 p:=Range(Wurf(20)+PreisHw+c_QuaPreis[q],20);
  541.                 write(Ausfile," & ",QualText(q)," & ",PreisText(p),"\\\\\n")
  542.             end;
  543.             if line>30 then Ausgabe_TeX_Header("Handwerker");
  544.             if HandwII>0 then for i:=1 to HandwII do begin
  545.                 q:=Range(Wurf(20)+Qual,20); j:=Check_Vorh(f_HandwII,23);
  546.                 write(Ausfile,num:4," & ",c_HandwII[j]," & "); inc(num); inc(line);
  547.                 case q of
  548.                     1,2:     write(Ausfile,"Spezialist, Wunschanfertigungen");
  549.                     3..6:  write(Ausfile,"Sonderanfertigungen");
  550.                     7..14: write(Ausfile,"solide Handwerksarbeiten");
  551.                     15..18:write(Ausfile,"einfache Arbeiten");
  552.                     19,20: write(Ausfile,"Pfuscher")
  553.                 end;
  554.                 q:=Range(Wurf(20)+Qual,20); p:=Range(Wurf(20)+PreisHw+c_QuaPreis[q],20);
  555.                 write(Ausfile," & ",QualText(q)," & ",PreisText(p),"\\\\\n")
  556.             end;
  557.             if line>30 then Ausgabe_TeX_Header("Handwerker");
  558.             if HandwIII>0 then for i:=1 to HandwIII do begin
  559.                 q:=Range(Wurf(20)+Qual,20); j:=Check_Vorh(f_HandwIII,12);
  560.                 write(Ausfile,num:4," & ",c_HandwIII[j]," & "); inc(num); inc(line);
  561.                 case q of
  562.                     1,2:     write(Ausfile,"Spezialist, Wunschanfertigungen");
  563.                     3..6:  write(Ausfile,"Sonderanfertigungen");
  564.                     7..14: write(Ausfile,"solide Handwerksarbeiten");
  565.                     15..18:write(Ausfile,"einfache Arbeiten");
  566.                     19,20: write(Ausfile,"Pfuscher")
  567.                 end;
  568.                 q:=Range(Wurf(20)+Qual,20); p:=Range(Wurf(20)+PreisHw+c_QuaPreis[q],20);
  569.                 write(Ausfile," & ",QualText(q)," & ",PreisText(p),"\\\\\n")
  570.             end;
  571.             if HandwI+HandwII+HandwIII=0 then
  572.                 write(Ausfile,"    \\multicolumn{5}{|c|}{keine}\\\\\n")
  573.         end;
  574.         if line>30 then Ausgabe_TeX_Header(" ");
  575.         if CheckOut(Gross) then begin
  576.             write(Ausfile,"  \\\hline\\hline\n  \\multicolumn{5}{|c|}{\\large\\bf\\rule{0pt}{2ex} Gro\"sbetriebe}\\\\[3pt]\n");
  577.             if Gross>0 then begin
  578.                 for i:=1 to Gross do begin j:=Check_Vorh(f_Gross,12);
  579.                     write(Ausfile,num:4," & ",c_Gross[j]," & "); inc(num); inc(line);
  580.                     q:=RangeRandom(20);
  581.                     case q of
  582.                         1,2:write(Ausfile,"Einzelverkauf");
  583.                         3,4:write(Ausfile,"w\"ochentlicher Verkauf");
  584.                         else write(Ausfile,"Verkauf nur an H\"andler/Betriebe")
  585.                     end;
  586.                     q:=Range(Wurf(20)+Qual,20); p:=Range(Wurf(20)+PreisHw+c_QuaPreis[q],20);
  587.                     write(Ausfile," & ",QualText(q)," & ",PreisText(p),"\\\\\n")
  588.                 end
  589.             end else write(Ausfile,"    \\multicolumn{5}{|c|}{keine}\\\\\n")
  590.         end
  591.     end;
  592.  
  593. begin    {Ausgabe_Text}
  594.     line:=1; num:=1; Ausgabe_TeX_Header(" ");
  595.     if CheckOut(Markt) then begin
  596.         write(Ausfile,"  \\hline\\hline\n  \\multicolumn{5}{|c|}{\\large\\bf\\rule{0pt}{2ex} Markttag}\\\\[3pt]\n  \\multicolumn{5}{|c|}{");
  597.         if Markt>0 then write(Ausfile,Markt," mal im Monat")
  598.         else if Markt<0 then write(Ausfile,"st\"andig, au\"ser an Feiertagen")
  599.                  else write(Ausfile,"keiner");
  600.         write(Ausfile,"}\\\\\n")
  601.     end;
  602.     if CheckOut(Tempel) then begin
  603.         write(Ausfile,"  \\hline\\hline\n  \\multicolumn{5}{|c|}{\\large\\bf\\rule{0pt}{2ex} Tempel}\\\\[3pt]\n");
  604.         if Tempel>0 then begin
  605.             j:=Tempel shl 1;
  606.             for i:=1 to Tempel do begin
  607.                 write(Ausfile,num:4," & ",c_Tempel[Range(Wurf(j),12)]," &&&\\\\\n");
  608.                 inc(num); inc(line)
  609.             end;
  610.         end else if Tempel<0 then begin
  611.             write(Ausfile,"    \\multicolumn{5}{|c|}{",c_Siehe,"}\\\\\n"); Tempel:=Wurf(4)+2
  612.         end else write(Ausfile,"    \\multicolumn{5}{|c|}{keine}\\\\\n");
  613.     end;
  614.     Aus_Hot_Kneip_Handw;
  615.     if line>30 then Ausgabe_TeX_Header(" ");
  616.     if CheckOut(HaendlI+HaendlII+HaendlIII) then begin
  617.         write(Ausfile,"  \\\hline\\hline\n  \\multicolumn{5}{|c|}{\\large\\bf\\rule{0pt}{2ex} H\"andler}\\\\[3pt]\n");
  618.         if HaendlI>0 then for i:=1 to HaendlI do begin
  619.             q:=Range(Wurf(20)+Qual,20); p:=Range(Wurf(20)+PreisHw+c_QuaPreis[q],20);
  620.             j:=Check_Vorh(f_HaendlI,3);
  621.             write(Ausfile,num:4," & ",c_HaendlI[j]," & "); inc(num); inc(line);
  622.             case q of
  623.                 1,2:     write(Ausfile,"auch seltene Waren");
  624.                 3..6:  write(Ausfile,"gro\"se Auswahl");
  625.                 7..14: write(Ausfile,"\"ubliche Auswahl");
  626.                 15..18:write(Ausfile,"auch Gebrauchtwaren");
  627.                 19,20: write(Ausfile,"Tr\"odel und Ramsch")
  628.             end;
  629.             q:=(Range(Wurf(20)+Qual,20)+q)div 2;
  630.             write(Ausfile," & ",QualText(q)," & ",PreisText(p),"\\\\\n")
  631.         end;
  632.         if line>30 then Ausgabe_TeX_Header("H\"andler");
  633.         if HaendlII>0 then for i:=1 to HaendlII do begin
  634.             q:=Range(Wurf(20)+Qual,20); p:=Range(Wurf(20)+PreisHw+c_QuaPreis[q],20);
  635.             j:=Check_Vorh(f_HaendlII,8);
  636.             write(Ausfile,num:4," & ",c_HaendlII[j]," & "); inc(num); inc(line);
  637.             case q of
  638.                 1,2:     write(Ausfile,"auch seltene Waren");
  639.                 3..6:  write(Ausfile,"gro\"se Auswahl");
  640.                 7..14: write(Ausfile,"\"ubliche Auswahl");
  641.                 15..18:write(Ausfile,"auch Gebrauchtwaren");
  642.                 19,20: write(Ausfile,"Tr\"odel und Ramsch")
  643.             end;
  644.             q:=(Range(Wurf(20)+Qual,20)+q)div 2;
  645.             write(Ausfile," & ",QualText(q)," & ",PreisText(p),"\\\\\n")
  646.         end;
  647.         if line>30 then Ausgabe_TeX_Header("H\"andler");
  648.         if HaendlIII>0 then for i:=1 to HaendlIII do begin
  649.             q:=Range(Wurf(20)+Qual,20); p:=Range(Wurf(20)+PreisHw+c_QuaPreis[q],20);
  650.             j:=Check_Vorh(f_HaendlIII,10);
  651.             write(Ausfile,num:4," & ",c_HaendlIII[j]," & "); inc(num); inc(line);
  652.             case q of
  653.                 1,2:     write(Ausfile,"auch seltene Waren");
  654.                 3..6:  write(Ausfile,"gro\"se Auswahl");
  655.                 7..14: write(Ausfile,"\"ubliche Auswahl");
  656.                 15..18:write(Ausfile,"auch Gebrauchtwaren");
  657.                 19,20: write(Ausfile,"Tr\"odel und Ramsch")
  658.             end;
  659.             q:=(Range(Wurf(20)+Qual,20)+q)div 2;
  660.             write(Ausfile," & ",QualText(q)," & ",PreisText(p),"\\\\\n")
  661.         end;
  662.         if HaendlI+HaendlII+HaendlIII=0 then
  663.             write(Ausfile,"    \\multicolumn{5}{|c|}{keine}\\\\\n");
  664.     end;
  665.     if line>30 then Ausgabe_TeX_Header(" ");
  666.     if CheckOut(DienstI+DienstII) then begin
  667.         write(Ausfile,"  \\\hline\\hline\n  \\multicolumn{5}{|c|}{\\large\\bf\\rule{0pt}{2ex} Dienstleistungen}\\\\[3pt]\n");
  668.         if DienstI>0 then for i:=1 to DienstI do begin
  669.             q:=Range(Wurf(20)+Qual,20); p:=Range(Wurf(20)+PreisHw+c_QuaPreis[q],20);
  670.             j:=Check_Vorh(f_DienstI,4);
  671.             write(Ausfile,num:4," & ",c_DienstI[j]," & "); inc(num); inc(line);
  672.             case q of
  673.                 1,2:     write(Ausfile,"nur Sonderw\"unsche");
  674.                 3..6:  write(Ausfile,"auch Sonderw\"unsche");
  675.                 7..14: write(Ausfile,"solide und gut ausgef\"uhrt");
  676.                 15..18:write(Ausfile,"einfach, aber zufriedenstellend");
  677.                 19,20: write(Ausfile,"zweifelhaft")
  678.             end;
  679.             q:=(Range(Wurf(20)+Qual,20)+q)div 2;
  680.             write(Ausfile," & ",QualText(q)," & ",PreisText(p),"\\\\\n")
  681.         end;
  682.         if line>30 then Ausgabe_TeX_Header("Dienstleistungen");
  683.         if DienstII>0 then for i:=1 to DienstII do begin
  684.             j:=Check_Vorh(f_DienstII,14);
  685.             q:=Range(Wurf(20)+Qual,20); p:=Range(Wurf(20)+PreisHw+c_QuaPreis[q],20);
  686.             write(Ausfile,num:4," & ",c_DienstII[j]," & "); inc(num); inc(line);
  687.             case q of
  688.                 1,2:     write(Ausfile,"nur Sonderw\"unsche");
  689.                 3..6:  write(Ausfile,"auch Sonderw\"unsche");
  690.                 7..14: write(Ausfile,"solide und gut ausgef\"uhrt");
  691.                 15..18:write(Ausfile,"einfach, aber zufriedenstellend");
  692.                 19,20: write(Ausfile,"zweifelhaft")
  693.             end;
  694.             q:=(Range(Wurf(20)+Qual,20)+q)div 2;
  695.             write(Ausfile," & ",QualText(q)," & ",PreisText(p),"\\\\\n")
  696.         end;
  697.         if DienstI+DienstII=0 then write(Ausfile,"    \\multicolumn{5}{|c|}{keine}\\\\\n");
  698.     end;
  699.     if line>30 then Ausgabe_TeX_Header(" ");
  700.     if CheckOut(Heilk) then begin
  701.         write(Ausfile,"  \\\hline\\hline\n  \\multicolumn{5}{|c|}{\\large\\bf\\rule{0pt}{2ex} Heilkundige}\\\\[3pt]\n");
  702.         if Heilk>0 then for i:=1 to Heilk do begin
  703.                 q:=Range(Wurf(20)+Qual,20); p:=Range(Wurf(20)+PreisHw+c_QuaPreis[q],20);
  704.                 j:=Check_Vorh(f_Heilk,4);
  705.                 write(Ausfile,num:4," & ",c_Heilk[j]," & "); inc(num); inc(line);
  706.                 case q of
  707.                     1,2:     write(Ausfile,"studierter Medikus, Spezialist");
  708.                     3..6:    write(Ausfile,"bewanderter, guter Heiler");
  709.                     7..14: write(Ausfile,"erfahrener Heiler");
  710.                     15..18:write(Ausfile,"Wundheiler, Zahnrei\"ser");
  711.                     19,20: write(Ausfile,"Heilerfolg zweifelhaft")
  712.                 end;
  713.                 write(Ausfile," & ",QualText(q)," & ",PreisText(p),"\\\\\n")
  714.             end
  715.         else write(Ausfile,"    \\multicolumn{5}{|c|}{keine}\\\\\n");
  716.     end;
  717.     if line>28 then Ausgabe_TeX_Header(" ");
  718.     if CheckOut(Durch) then begin
  719.         write(Ausfile,"  \\\hline\\hline\n  \\multicolumn{5}{|c|}{\\large\\bf\\rule{0pt}{2ex} Durchfahrende H\"andler, Handwerker, K\"unstler etc.}\\\\[3pt]\n");
  720.         if Durch>0 then begin
  721.             for i:=1 to Durch shl 1 do begin
  722.                 if line>30 then Ausgabe_TeX_Header("Durchfahrende H\"andler, Handwerker, K\"unstler etc.");
  723.                 q:=Wurf(20); p:=Range(Wurf(20)+c_QuaPreis[q],20); j:=Check_Vorh(f_Durch,10);
  724.                 write(Ausfile," & ",c_Durch[j]," & "); inc(line);
  725.                 if j=4 then case Wurf(20) of
  726.                     1,2:write(Ausfile,"Feuerspucker/-schlucker");
  727.                     3..5:write(Ausfile,"Jongleure");
  728.                     6:write(Ausfile,"Hochseilakt");
  729.                     7,8:write(Ausfile,"Messerwerfer");
  730.                     9:write(Ausfile,"Entfesselungsk\"unstler");
  731.                     10:write(Ausfile,"Tanzb\"ar");
  732.                 end else if j=5 then case Wurf(10) of
  733.                     1,2:write(Ausfile,"nur S\"anger");
  734.                     3,4:write(Ausfile,"Lauten und Trommel");
  735.                     5,6:write(Ausfile,"Fl\"otenspiel");
  736.                     7,8:write(Ausfile,"Leierkasten");
  737.                     9,10:write(Ausfile,"Harfe")
  738.                 end;
  739.                 write(Ausfile," & ",QualText(q)," & ",PreisText(p),"\\\\\n")
  740.             end;
  741.             write(Ausfile,"    & \\multicolumn{4}{c|}{\\qquad Weiterhin ");
  742.             case Durch of
  743.                 1:write(Ausfile,"gelegentlich Durchfahrende");
  744.                 2:write(Ausfile,"h\"aufig Durchfahrende");
  745.                 else write(Ausfile,"st\"andig Durchreisende, au\"serdem Stra\"senh\"andler")
  746.             end; write(Ausfile,"}\\\\\n")
  747.         end else write(Ausfile,"    \\multicolumn{5}{|c|}{keine}\\\\\n");
  748.     end;
  749.     write(Ausfile,"  \\hline\n")
  750. end;
  751.  
  752. procedure Init_Vars;
  753. var i,j:integer;
  754.         t:t_Feld;
  755. begin
  756.   for i:=1 to c_Groesse do for j:=1 to c_Groesse do begin
  757.         Dorf[i,j].Feld:=f_Leer; Dorf[i,j].num:=0 end;
  758.     Bau[f_Haus1]:="HausEins"; Bau[f_Haus2]:="HausZwei"; Bau[f_Haus3]:="HausDrei";
  759.     Bau[f_Haus4]:="HausVier"; Bau[f_Haus5]:="HausFuenf"; Bau[f_Tempel1]:="TempelEins";
  760.     Bau[f_Tempel2]:="TempelZwei"; Bau[f_Hotel1]:="HotelEins";
  761.     Bau[f_Hotel2]:="HotelZwei"; Bau[f_Hotel3]:="HotelDrei";
  762.     Bau[f_Kneipe1]:="KneipeEins"; Bau[f_Kneipe2]:="KneipeZwei";
  763.     Bau[f_HandwI]:="HandwI"; Bau[f_HandwII]:="HandwII"; Bau[f_HandwIII]:="HandwIII";
  764.     Bau[f_Gross]:="Gross"; Bau[f_HaendlI]:="HaendlI"; Bau[f_HaendlII]:="HaendlII";
  765.     Bau[f_HaendlIII]:="HaendlIII"; Bau[f_DienstI]:="DienstI";
  766.     Bau[f_DienstII]:="DienstII"; Bau[f_Heilk]:="Heilk"; Bau[f_Markt]:="Markt";
  767.     Bau[f_Teich]:="Teich"; Bau[f_Baum1]:="BaumEins"; Bau[f_Baum2]:="BaumZwei";
  768.     Bau[f_Baum3]:="BaumDrei"; Bau[f_Leer]:="Leer";
  769.     for t:=f_Haus1 to f_Durch do Vorh[t]:=0;
  770. end;
  771.  
  772.  
  773. begin    { Main }
  774.     write("\f\n            \e[1mDSA Dorfgenerator\e[0m V",Version,"\n\n        © copyright 1995/96 by Henning Peters\n    E-Mail: faroul@beyond.hb.north.de\n\n    1) bis   100 Einwohner\n    2) bis   250 Einwohner\n    3) bis   500 Einwohner\n    4) bis  1000 Einwohner\n    5) bis  2500 Einwohner\n    6) bis  5000 Einwohner\n    7) bis 10000 Einwohner\n\n    (Größe 1-4 mit grafischer Ausgabe im LaTeX-Format)\n\nWelche Größenklasse hat das Dorf? ");
  775.     { \e=Esc=chr(27); \f=chr(12)=ClearScreen; \e[1m=BoldOn, \e[0m=BoldOff,
  776.         \a=Attention=chr(7); \n=Linefeed }
  777.     str:=AllocString(60); readln(str); Dorf_Num:=str_int(str);
  778.     if Dorf_Num<1 then Dorf_Num:=1 else if Dorf_Num>7 then Dorf_Num:=7;
  779.     if Dorf_Num>4 then write("\nStädte dieser Größse sind auch im Buch \"Das Land des Schwarzen Auges\"\noder im \"Lexikon des Schwarzen Auges\" beschrieben.\n");
  780.     Name:=AllocString(40); selfseed;    { Zufallsgenerator starten }
  781.     repeat ok:=true;
  782.         write("\nWie soll das Dorf heißen (keine Leerzeichen)? "); readln(Name);
  783.         if Dorf_Num<5 then begin
  784.             strcpy(str,Name); strcat(str,".pic");
  785.             if reopen(str,Ausfile) then begin
  786.                 close(Ausfile); ok:=false
  787.             end
  788.         end;
  789.         strcpy(str,Name); strcat(str,".tex");
  790.         if reopen(str,Ausfile) then begin
  791.             close(Ausfile); ok:=false
  792.         end;
  793.         strcpy(str,Name); strcat(str,".data");
  794.         if reopen(str,Ausfile) then begin
  795.             close(Ausfile); ok:=false
  796.         end;
  797.         if not ok then begin
  798.             write("\n\aAchtung! Zum Dorf `",Name,"' existieren bereits Dateien!\n     Überschreiben (j/n)? ");
  799.             readln(str); ok:=tolower(str[0])='j'
  800.         end
  801.     until ok;
  802.     write("\nSollen nicht existierende Betriebe ausgegeben werden (j/n)? ");
  803.     readln(str); Aus_Leer:=tolower(str[0])='j';
  804.     write("\nWollen Sie die Dorfdaten selber eingeben (j/n)? ");
  805.     readln(str); ok:=tolower(str[0])='j';
  806.     Init_Vars;
  807.     if ok then Eingabe else Generate_Dorf;
  808.     strcpy(str,Name); strcat(str,".tex");
  809.     if open(str,Ausfile,1024) then begin
  810.         Ausgabe_Text; close(Ausfile);
  811.     end else write("\n\n    \aKonnte `",str,"' nicht zum Schreiben öffnen!\n");
  812.     xy:=6+Einw div 83; strcpy(str,Name); strcat(str,".data");
  813.     if open(str,Ausfile,1024) then begin
  814.       write(Ausfile,"\\def\\PicSize{",xy*32+6,"} \\def\\un{",15.5/xy:1:2,"pt}\n");
  815.         close(Ausfile);
  816.     end else write("\aKonnte `",str,"' nicht zum Schreiben öffnen!\n");
  817.     if Dorf_Num<5 then begin
  818.         Generate_Bild;
  819.         strcpy(str,Name); strcat(str,".pic");
  820.         if open(str,Ausfile,1024) then begin
  821.             Ausgabe_Bild; close(Ausfile);
  822.         end else write("\n\n    \aKonnte `",str,"' nicht zum Schreiben öffnen!\n")
  823.     end;
  824.     write("Ok.");
  825.     if (Dorf_Num>2) and (Dorf_Num<5) then
  826.         write("\n\n    Bei einem Dorf dieser Größe ggf. BigLaTeX benutzen!\n");
  827.     write("\n\n")
  828. end.
  829.  
  830.